home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO004.dsk / FILECAB.INITIAL.bas < prev    next >
BASIC Source File  |  2012-02-16  |  5KB  |  123 lines
  1. 5  REM  FILE CABINET INITIALIZER
  2. 10  REM      WRITTEN BY
  3. 15  REM     MIKE KRAMER
  4. 17  REM       HAAUG
  5. 20  REM       1/7/81
  6. 21 :
  7. 22  REM    PRODOS VERSION  
  8. 23  REM  BY MICHAEL MOORE 6/17/84
  9. 25  REM 
  10. 28  TEXT 
  11. 30  HOME : VTAB 10: FOR N = 1 TO 39: PRINT "*";: NEXT N: VTAB 12: HTAB 5: PRINT "FILE CABINET FILE INITIALIZER": PRINT : HTAB 15: PRINT "WRITTEN BY": PRINT : HTAB 14: PRINT "MIKE KRAMER"
  12. 35  VTAB 18: PRINT "   PRODOS VERSION BY MICHAEL MOORE": VTAB 19: FOR N = 1 TO 39: PRINT "*";: NEXT N
  13. 40  VTAB 20: HTAB 13: INPUT "INSTRUCTIONS (Y/N) ? ";YN$:YN$ =  LEFT$(YN$,1): IF YN$ < >"Y"  AND YN$ < >"N"  THEN  GOTO 40
  14. 50  IF YN$ = "Y" GOTO 770
  15. 60  GOSUB 680: REM  POKE IN ONERR ROUTINE
  16. 70  HOME : CLEAR 
  17. 80  VTAB 12: PRINT "INSERT FILE CABINET DISK - PRESS A KEY";: GET A$: PRINT 
  18. 90 D$ =  CHR$(4)
  19. 100  PRINT D$;"PREFIX"
  20. 110  INPUT PX$: REM  OBTAIN CURRENT DISK PATH
  21. 120  DIM HD$(20),BN$(40)
  22. 130  ONERR  GOTO 630
  23. 135  PRINT D$;"VERIFY";PX$ +"BASENAMES"
  24. 140  PRINT D$;"OPEN";PX$ +"BASENAMES"
  25. 145  PRINT D$;"READ";PX$ +"BASENAMES"
  26. 150  INPUT NB$:NB =  VAL(NB$)
  27. 160  FOR N = 1 TO NB: INPUT BN$(N): NEXT N
  28. 170  PRINT D$;"CLOSE"
  29. 180  ONERR  GOTO 650
  30. 182  VTAB 14: CALL  -958: PRINT 
  31. 185  PRINT "TO EXIT THE PROGRAM, PRESS 'RETURN'"
  32. 187  PRINT "INSTEAD OF ENTERING A DATA BASE NAME."
  33. 190  PRINT : INPUT "NAME OF NEW DATA BASE? ";DB$: IF  LEN(DB$) = 0  THEN  HOME : GOTO 600
  34. 200  IF  ASC( LEFT$(DB$,1)) <65  OR  ASC( LEFT$(DB$,1)) >91  THEN  PRINT : PRINT "NAME MUST START WITH A LETTER.": GOSUB 910: GOTO 182
  35. 210  IF  LEN(DB$) >19  THEN  PRINT : PRINT "NAME MUST HAVE LESS THAN 20 CHARACTERS": GOSUB 910: GOTO 182
  36. 212  FOR L = 1 TO  LEN(DB$)
  37. 214  IF  ASC( MID$ (DB$,L,1)) <46  OR  ASC( MID$ (DB$,L,1)) >90  OR  ASC( MID$ (DB$,L,1)) = 47  THEN FLAG = 1:L =  LEN(DB$): GOTO 217
  38. 215  IF  ASC( MID$ (DB$,L,1)) <65  AND  ASC( MID$ (DB$,L,1)) >57  THEN FLAG = 1:L =  LEN(DB$)
  39. 217  NEXT L
  40. 219  IF FLAG  THEN  PRINT "ONLY LETTERS, NUMERALS, OR PERIODS ARE  PERMITTED WITHIN A DATA BASE NAME.":FLAG = 0: PRINT "PRESS ANY KEY TO CONTINUE.";: GET K$: GOTO 182
  41. 220  FOR J = 1 TO NB
  42. 230  IF DB$ = BN$(J) GOTO 260
  43. 240  NEXT J
  44. 250 NB = NB +1:NB$ =  STR$(NB):BN$(NB) = DB$: GOTO 300
  45. 260  PRINT : PRINT ;" ALREADY EXISTS.": PRINT : INPUT "REPLACE EXISTING FILE (Y/N) ? ";YN$:YN$ =  LEFT$(YN$,1): IF YN$ < >"Y"  AND YN$ < >"N" GOTO 260
  46. 270  IF YN$ = "N" GOTO 182
  47. 280  PRINT D$;"DELETE";PX$ +BN$(NB) +"/" +"HEADER"
  48. 290  PRINT D$;"DELETE";PX$ +BN$(NB) +"/" +"INDEX"
  49. 295  PRINT D$;"DELETE";PX$ +BN$(NB)
  50. 300  PRINT : INPUT "NUMBER OF RECORDS? ";NR$:NR =  VAL(NR$): IF NR <1 GOTO 300
  51. 310 NH = 0
  52. 320  PRINT : PRINT "ENTER HEADER # ";NH +1;": ";: INPUT "";H$: IF  LEN(H$) < >0  THEN NH = NH +1:HD$(NH) = H$: GOTO 320
  53. 330  IF NH = 0 GOTO 320
  54. 335  PRINT D$;"CREATE";PX$ +BN$(NB)
  55. 340 Q$ = PX$ +BN$(NB) +"/" +"HEADER"
  56. 350  PRINT D$;"OPEN";Q$
  57. 360  PRINT D$;"WRITE";Q$
  58. 370  PRINT NH
  59. 380  FOR N = 1 TO NH
  60. 390  PRINT HD$(N)
  61. 400  NEXT N
  62. 410  PRINT D$;"CLOSE"
  63. 420 Q$ = PX$ +BN$(NB) +"/" +"INDEX"
  64. 430  PRINT D$;"OPEN";Q$
  65. 440  PRINT D$;"WRITE";Q$
  66. 450  PRINT NR
  67. 460  FOR M = 1 TO NR
  68. 470  FOR N = 1 TO NH
  69. 480  PRINT  CHR$(32)
  70. 490  NEXT N: NEXT M
  71. 500  PRINT D$;"CLOSE"
  72. 510 Q$ = PX$ +"BASENAMES"
  73. 513  PRINT D$;"OPEN";Q$
  74. 517  PRINT D$;"WRITE";Q$
  75. 520  PRINT NB
  76. 530  FOR N = 1 TO NB
  77. 540  PRINT BN$(N)
  78. 550  NEXT N
  79. 560  PRINT D$"CLOSE"
  80. 570  PRINT : INPUT "INITIALIZE MORE FILES (Y/N) ? ";YN$:YN$ =  LEFT$(YN$,1): IF YN$ < >"Y"  AND YN$ < >"N" GOTO 570
  81. 580  IF YN$ = "N"  THEN  HOME : GOTO 600
  82. 590  GOTO 70
  83. 600 :
  84. 610  HOME : END 
  85. 620  REM   ** APPLESOFT ONERR CORRECTION
  86. 630  CALL 1013:I =  PEEK(222): IF I = 5  OR I = 6  THEN  POKE 216,0: HOME : GOTO 180 REM    NO BASENAMEFILE .. LET ONE BE CREATED
  87. 640  GOTO 660
  88. 650  CALL 1013
  89. 660  HOME : VTAB 12: GOSUB 730: IF I >3  AND I <10  THEN  PRINT : PRINT "CORRECT ERROR, THEN PRESS A KEY:";: GET A$: PRINT : RESUME 
  90. 670  PRINT "FATAL ERROR IN LINE "; PEEK(218) +256 * PEEK(219): VTAB 23: END 
  91. 680  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT I
  92. 690 I = 0
  93. 700  RETURN 
  94. 710  DATA   104,168,104,166,223,154,72,152,72,96
  95. 720  REM ERROR MESSAGE PRINTING ADAPTED FROM CALL APPLE 9/80 
  96. 730 MSG$ =  CHR$(0):I =  PEEK(222): POKE 216,0: IF I = 0  OR I >15  THEN J = 53856 +I +(I = 255) * -1: GOTO 750
  97. 740 J = 43377 + PEEK(43583 +I)
  98. 750 K =  PEEK(J):MSG$ = MSG$ + CHR$(K): IF K <192  THEN J = J +1: GOTO 750
  99. 760  PRINT MSG$: PRINT : RETURN 
  100. 770  HOME : PRINT 
  101. 780  PRINT  TAB( 2)"** FILE CABINET FILE INITIALIZER **": PRINT 
  102. 790  PRINT "THIS PROGRAM SETS UP FILE CABINET FILES WITH A SPECIFIED NUMBER OF RECORDS."
  103. 800  PRINT 
  104. 810  PRINT "YOU WILL BE ASKED FOR THE NEW DATA BASE NAME, THE NUMBER OF RECORDS, AND THE    HEADERS TO  BE USED. IF THE DATA BASE   NAMED IS IN THE BASENAMEFILE, YOU WILL  BE GIVEN A CHANCE TO ENTER ANOTHER NAME IF DESIRED."
  105. 820  PRINT : PRINT "WHEN THE DESIRED HEADERS HAVE BEEN      ENTERED, PRESS <RETURN> TO INDICATE     THERE ARE NO MORE."
  106. 830  VTAB 22: PRINT "PRESS <RETURN> TO CONTINUE,<ESC> TO EXIT";: GET A$: PRINT ;
  107. 840  IF A$ =  CHR$(13) GOTO 60
  108. 850  IF A$ =  CHR$(27)  THEN  HOME : END 
  109. 860  GOTO 830
  110. 900  REM  << CONTINUE REQUEST >>
  111. 910  PRINT "PRESS ANY KEY TO CONTINUE";: GET K$
  112. 920  RETURN 
  113. 1000  REM  ***********************
  114. 1010  REM       FILE CABINET                 INITIALIZER
  115. 1020  REM   ORIGINAL 3.3 VERSION
  116. 1030  REM      BY MIKE KRAMER
  117. 1040  REM  
  118. 1050  REM     PRODOS VERSION 
  119. 1060  REM     BY MICHAEL MOORE
  120. 1070  REM      6/17/84
  121. 1080  REM 
  122. 1090  REM  **********************
  123. 1100  REM   APPLE CORPS OF DALLAS